home *** CD-ROM | disk | FTP | other *** search
/ Hottest 5 / Hottest 5 (1995)(PDSoft)[!].iso / pdsoft / library / lha / board1.lha / Backgammon / init.bas < prev    next >
BASIC Source File  |  1980-01-10  |  11KB  |  302 lines
  1. 10    GOTO 1540
  2. 20    b1=-99999:ss=0:ht=0:b5=0:td(1)=d(0):td(2)=d(1):td(3)=d(0):td(4)=d(0)
  3. 30    FOR i=1 TO 4:tm(i)=24:NEXT i:nm=mm:j=-b(0):IF j>mm THEN j=mm
  4. 40    IF j>0 THEN FOR i=1 TO j:tm(i)=26:NEXT i
  5. 50    FOR i=0 TO 25:tb(i)=b(i):NEXT i:mt=0
  6. 60    tm=me(0):FOR i=1 TO nm:IF tm(i)<26 THEN 100
  7. 70    IF tb(25-td(i))>1 THEN 720
  8. 80    IF tb(25-td(i))=1 THEN tb(25)=tb(25)+1:tb(25-td(i))=0
  9. 90    tb(25-td(i))=tb(25-td(i))-1:tb(0)=tb(0)+1:GOTO 230
  10. 100   IF i>1 THEN IF tm(i)+ss>tm(i-1) THEN 120
  11. 110   IF tb(tm(i))<0 THEN 140
  12. 120   tm(i)=tm(i)-1:IF tm(i)>0 THEN 100
  13. 130   GOTO 670
  14. 140   IF tm(i)-td(i)<1 THEN 180
  15. 150   IF tb(tm(i)-td(i))>1 THEN 120
  16. 160   IF tb(tm(i)-td(i))=1 THEN tb(25)=tb(25)+1:tb(tm(i)-td(i))=0
  17. 170   tb(tm(i)-td(i))=tb(tm(i)-td(i))-1:tb(tm(i))=tb(tm(i))+1:GOTO 230
  18. 180   FOR j=7 TO 24:IF tb(j)<0 THEN 670
  19. 190   NEXT j:IF tm(i)-td(i)=0 THEN 220
  20. 200   jm=tm(i)+1:FOR j=jm TO 6:IF tb(j)<0 THEN 670
  21. 210   NEXT j
  22. 220   tb(tm(i))=tb(tm(i))+1:tm=tm-1
  23. 230   mt=mt+td(i):NEXT i
  24. 240   IF mt<ht THEN 720
  25. 250   ht=mt:mi=0:bt=0:FOR i=1 TO 24
  26. 260   IF tb(i)>0 THEN IF i<19 THEN mi=mi+tb(i)*INT((22-i)/4)/2
  27. 270   IF tb(i)<0 THEN IF i>6 THEN mi=mi+tb(i)*INT((i-3)/4)/2
  28. 280   NEXT i:mi=mi+3*(tb(0)+tb(25)):IF tb(25)>1 THEN mi=mi+1
  29. 290   ct=0:IF tb(25)-tb(0) THEN ct=1:GOTO 340
  30. 300   FOR i=24 TO 2 STEP -1:IF tb(i)<0 THEN 320
  31. 310   NEXT i:GOTO 340
  32. 320   FOR j=i-1 TO 1 STEP -1:IF tb(j)>0 THEN ct=1:GOTO 340
  33. 330   NEXT j
  34. 340   bl=0
  35. 350   IF ct=0 THEN bt=0:GOTO 420
  36. 360   hp=0:FOR i=1 TO 24
  37. 370   IF tb(i)=-1 THEN bt=bt-INT((30-i)/4)/2:IF i<7 THEN mi=mi-1
  38. 380   IF i>18 AND b(i)>1 THEN hp=hp+1
  39. 390   NEXT i:hp=hp*hp+(hp=0):bt=INT(bt*hp/25+.5)/2
  40. 400   FOR i=1 TO 4:b=0:FOR j=i TO i+5:b=b-(tb(j)<-1):NEXT j
  41. 410   b=INT(b*b/4):bl=bl-(b>bl)*(b-bl):NEXT i
  42. 420   IF mi+bl+bt<b1+b2+b3 THEN 630
  43. 430   tc=0:bo=0:ds=0:lo=1:FOR i=1 TO 24
  44. 440   IF i>6 THEN IF tb(i)<0 THEN tc=tc+tb(i)*INT((i-1)/6):bo=bo+i*tb(i)
  45. 450   IF tb(i)<0 THEN ds=ds+1:lo=lo*(0-tb(i))
  46. 460   NEXT i
  47. 470   IF b1=-99999 THEN 600
  48. 480   IF bl+mi+bt>b2+b1+b3 THEN 600
  49. 490   IF tm<b9 THEN 600
  50. 500   IF tm>b9 THEN 630
  51. 510   IF tc<b4 THEN 630
  52. 520   IF tc>b4 THEN 600
  53. 530   IF ds<b6 THEN 630
  54. 540   IF ds>b6 THEN 600
  55. 550   IF bo<b7 THEN 630
  56. 560   IF bo>b7 THEN 600
  57. 570   IF lo<b8 THEN 630
  58. 580   IF lo>b8 THEN 600
  59. 590   GOTO 630
  60. 600   b5=nm:b2=bl:b3=bt:b4=tc:b1=mi:b9=tm:b6=ds:bt=bo:b8=lo:j=1-(b5<mm)
  61. 610   FOR i=1 TO b5:sm(j)=tm(b5+1-i)
  62. 620   sd(j)=td(b5+1-i):j=j+1:NEXT i
  63. 630   IF tm(nm)=26 THEN 720
  64. 640   tm(nm)=tm(nm)-1
  65. 650   IF tm(nm)>0 THEN 50
  66. 660   i=nm
  67. 670   FOR j=i TO nm:tm(j)=24:NEXT j:i=i-1
  68. 680   IF i=0 THEN 720
  69. 690   IF tm(i)=26 THEN 720
  70. 700   IF tm(i)>1 THEN tm(i)=tm(i)-1:GOTO 50
  71. 710   GOTO 670
  72. 720   IF d(1)=d(0) THEN 760
  73. 730   IF ss=1 THEN 750
  74. 740   ss=1:td(1)=d(1):td(2)=d(0):GOTO 50
  75. 750   ss=0:td(1)=d(0):td(2)=d(1)
  76. 760   nm=nm-1:IF nm=0 THEN 780
  77. 770   IF ht=0 THEN 50
  78. 780   IF b5<mm THEN sm(1)=27
  79. 790   ms=mm:IF b5<mm THEN ms=b5+1
  80. 800   m=sm(ms):d=sd(ms):ms=ms-1:IF m=26 THEN m=0
  81. 810   IF m=27 THEN GOTO 910
  82. 820   mpt=m:GOSUB 2380
  83. 830   GOTO 1180
  84. 840   os=1:IF d(0)=2 AND d(1)=6 THEN d(0)=6:d(1)=2:os=2
  85. 850   sm(2)=op(0,6*d(0)+d(1)-7):sm(1)=op(1,6*d(0)+d(1)-7)
  86. 860   sd(2)=d(0):sd(1)=d(1):IF os=2 THEN d(0)=2:d(1)=6
  87. 870   IF mm=4 THEN sm(3)=sm(1):sd(3)=sd(1):sm(4)=sm(2):sd(4)=sd(2)
  88. 880   IF b(sm(1)-sd(1))>1 THEN 50
  89. 890   IF b(sm(2)-sd(2))>1 THEN 50
  90. 900   ms=mm:GOTO 800
  91. 910   FOR di=0 TO 1:IF d(di)>0 THEN GOSUB 2580
  92. 920   NEXT di:RANDOMIZE -1:d(0)=INT(6*RND(1)+1):d(1)=INT(6*RND(1)+1):pl=-pl:mm=2
  93. 930   IF d(0)=d(1) THEN mm=4
  94. 940   GOSUB 2420:pc=1:IF pl=1 THEN pc=0:GOTO 970
  95. 950   IF ms>0 THEN 800
  96. 960   IF os=0 THEN 840 ELSE 20
  97. 970   m=0:GOSUB 1870:IF mpt=26 THEN 1320
  98. 980   IF (b(25)>0 AND mpt<>25) OR mpt=0 OR b(mpt)<1 THEN 970
  99. 990   m=mpt:GOSUB 2380
  100. 1000  GOSUB 1870:IF mpt=m THEN GOSUB 2410:GOTO 970
  101. 1010  IF mpt>24 THEN 1000
  102. 1020  IF mpt=0 THEN mpt=25
  103. 1030  IF b(mpt)<-1 THEN 1000
  104. 1040  IF m=25 THEN d=mpt ELSE d=mpt-m
  105. 1050  IF d<1 OR d>6 THEN 1000
  106. 1060  di=-1:IF d=d(0) THEN di=0:GOTO 1110
  107. 1070  IF d=d(1) THEN di=1:GOTO 1110
  108. 1080  IF mpt=25 AND d(0)>d THEN d=d(0):di=0
  109. 1090  IF mpt=25 AND d(1)>d THEN d=d(1):di=1
  110. 1100  IF di=-1 THEN 1000
  111. 1110  IF m=25 THEN 1180
  112. 1120  IF m+d<25 THEN 1180
  113. 1130  FOR i=1 TO 18:IF b(i)>0 THEN 1000
  114. 1140  NEXT i
  115. 1150  IF m+d=25 THEN 1180
  116. 1160  FOR i=19 TO m-1:IF b(i)>0 THEN 1000
  117. 1170  NEXT i
  118. 1180  IF d=d(0) THEN di=0 ELSE di=1
  119. 1190  IF mm<3 THEN GOSUB 2580
  120. 1200  mm=mm-1:po=m:mn=ABS(b(po)):GOSUB 2300:d=d*pl:b(m)=b(m)-pl
  121. 1210  IF m=0 OR m=25 THEN m=25-m
  122. 1220  IF m+d<1 OR m+d>24 THEN 1290
  123. 1230  IF b(m+d)<>-pl THEN 1270
  124. 1240  po=m+d:mn=1:pc=1-pc
  125. 1250  GOSUB 2300:br=0:IF pl=-1 THEN br=25
  126. 1260  b(br)=b(br)-pl:b(m+d)=0:po=br:mn=ABS(b(br)):GOSUB 2270:pc=1-pc
  127. 1265  gosub 41000
  128. 1270  b(m+d)=b(m+d)+pl:po=m+d:mn=ABS(b(po))
  129. 1280  GOSUB 2270:gosub 41000:GOTO 1300
  130. 1290  me((pl+1)/2)=me((pl+1)/2)-1:IF me(0)=0 OR me(1)=0 THEN 1440
  131. 1300  IF mm=0 THEN 910
  132. 1310  GOTO 940
  133. 1320  IF b(25)=0 THEN 1350
  134. 1330  FOR i=0 TO 1:IF d(i)>0 AND b(d(i))>-2 THEN 970
  135. 1340  NEXT i:GOTO 910
  136. 1350  FOR i=0 TO 1:IF d(i)=0 THEN 1380
  137. 1360  FOR j=1 TO 24-d(i):IF b(j)>0 AND b(j+d(i))>-2 THEN 970
  138. 1370  NEXT j
  139. 1380  NEXT i:FOR j=1 TO 18:IF b(j)>0 THEN 910
  140. 1390  NEXT j:FOR i=0 TO 1:IF d(i)>0 AND b(25-d(i))>0 THEN 970
  141. 1400  NEXT i:FOR i=19 TO 24:IF b(i)>0 THEN 1420
  142. 1410  NEXT i:GOTO 910
  143. 1420  FOR j=0 TO 1:IF d(j)>0 AND d(j)>25-i THEN 970
  144. 1430  NEXT j:GOTO 910
  145. 1440  FOR di=0 TO 1:IF d(di)>0 THEN GOSUB 2580
  146. 1450  NEXT di
  147. 1460  pena 4
  148. 1470  IF me(0)=0 THEN msg$="I win " ELSE msg$="You win "
  149. 1480  IF me(0)<15 AND me(1)<15 THEN 1520
  150. 1490  IF b(0)<>0 OR b(25)<>0 THEN msg$=msg$+" WITH A BACKGAMMON":GOTO 1520
  151. 1500  FOR i=1 TO 6:IF b(i)>0 OR b(25-i)<0 THEN msg$=msg$+" WITH A BACKGAMMON":GOTO 1520
  152. 1510  NEXT i:msg$=msg$+" WITH A GAMMON"
  153. 1520  middle=(len(msg$)/2)*8:? at((18*8)-middle,183);msg$
  154. 1525  gosub 37000
  155. 1530  GOSUB 1870:GOTO 1720
  156. 1540  SCREEN 0,5:graphic 1:drawmode 0
  157. 1550  font 1:DIM regsave%(100):bload "pic_dat",VARPTR(regsave%(0)):GOSUB 30000
  158. 1560  dim picture%(11000):bload "pic",varptr(picture%(0))
  159. 1565  dim dice1%(200),dice2%(200),dice3%(200),dice4%(200),dice5%(200),dice6%(200)
  160. 1570  bload "dice1",varptr(dice1%(0)):bload "dice2",varptr(dice2%(0)):bload "dice3",varptr(dice3%(0))
  161. 1575  bload "dice4",varptr(dice4%(0)):bload "dice5",varptr(dice5%(0)):bload "dice6",varptr(dice6%(0))
  162. 1590  REM
  163. 1600  pena 7:PRINT  at(12*8,1*8);"AMIGA BACKGAMMON":PRINT 
  164. 1610  pena 8:? "     Amiga Version by David Addison":pena 9:? "       Original ST Version by TCB":?
  165. 1620  pena 4:PRINT  "  You will play the white pieces and ":? "move clockwise from the upper left."
  166. 1630  PRINT :PRINT  "  To move a piece, click on piece ":? "to be moved and then";
  167. 1640  PRINT  " click on the":PRINT  "destination point."
  168. 1650  PRINT :PRINT  "  To bear off use the GOLD bar on the ":? "left as the destination."
  169. 1660  PRINT :PRINT  "  If you do not have a valid move":? "click on the dice."
  170. 1670  PRINT :PRINT  "  To end the game click on ""A"""
  171. 1680  pena 11:PRINT  at(5*8,22*8);"Click mouse button to start."
  172. 1690  GOSUB 2700:REM v=rnd(-xc*yc)
  173. 1700  rem
  174. 1710  DIM b(25),tb(25),me(1),op(1,35),sm(4),sd(4),d(1),td(4),tm(4),sinewave%(11)
  175. 1720  FOR i=0 TO 25:b(i)=0:NEXT i
  176. 1730  b(1)=2:b(6)=-5:b(8)=-3:b(12)=5:b(13)=-5:b(17)=3:b(19)=5:b(24)=-2
  177. 1740  me(0)=15:me(1)=15
  178. 1750  ms=0:os=0
  179. 1760  RESTORE:FOR i=0 TO 35:READ x,y:op(0,i)=x:op(1,i)=y:NEXT i
  180. 1765  for i=0 to 11:read sinewave%(i):next i
  181. 1766  audio 15,1:wave 6,sinewave%
  182. 1770  GOSUB 1990
  183. 1780  RANDOMIZE -1:FOR i=0 TO 1:d(i)=INT(6*RND(1)+1):NEXT i:IF d(0)=d(1) THEN 1780
  184. 1790  pl=-1:mm=2:IF d(0)>d(1) THEN pl=1
  185. 1800  GOTO 940
  186. 1810  DATA 8,6,6,13,6,8,6,13,6,13,8,13
  187. 1820  DATA 13,6,13,6,13,13,6,8,13,13,0,0
  188. 1830  DATA 8,6,13,13,13,8,13,13,8,13,13,13
  189. 1840  DATA 13,6,8,6,13,13,13,9,13,13,13,13
  190. 1850  DATA 13,6,13,13,13,8,13,13,13,8,13,13
  191. 1860  DATA 13,8,13,7,13,13,13,13,13,13,24,13
  192. 1865  data 100,90,60,100,90,60,-100,-90,-60,-100,-90,-60
  193. 1870  GOSUB 2700:REM if button>1 then goto 1870
  194. 1880  IF yc<3 OR yc>169 OR xc>298 THEN GOTO 1870
  195. 1890  IF xc<5 THEN mpt=0:RETURN
  196. 1900  IF xc<144 THEN 1960
  197. 1910  IF xc>159 THEN 1940
  198. 1920  IF yc>98 THEN mpt=25:RETURN
  199. 1930  IF yc>73 THEN goto 40000 ELSE GOTO 1870
  200. 1940  IF yc>73 AND yc<98 THEN GOTO 1870
  201. 1950  xc=xc-18:GOTO 1970
  202. 1960  IF yc>73 AND yc<98 THEN mpt=26:RETURN
  203. 1970  xc=xc-4:ptx=xc\23:IF yc>98 THEN mpt=24-ptx ELSE mpt=ptx+1
  204. 1980  RETURN
  205. 1990  scnclr:outline 0:gshape(0,0),picture%()
  206. 2000  rem
  207. 2010  rem
  208. 2020  rem
  209. 2030  rem
  210. 2040  rem
  211. 2050  rem
  212. 2060  rem
  213. 2070  rem
  214. 2080  rem
  215. 2085  rem
  216. 2090  FOR po=0 TO 25
  217. 2100  IF b(po)=0 THEN 2130
  218. 2110  pc=1+(b(po)>0)
  219. 2120  FOR mn=1 TO ABS(b(po)):GOSUB 2270:NEXT mn
  220. 2130  NEXT po
  221. 2140  RETURN
  222. 2150  REM
  223. 2160  IF po<13 THEN pox=po-1 ELSE pox=24-po
  224. 2170  x=16+pox*23:IF pox>5 THEN x=x+18
  225. 2180  IF po=0 OR po=25 THEN x=151
  226. 2190  IF po<13 THEN y1=3:y2=73:yd=1 ELSE y1=169:y2=99:yd=-1
  227. 2200  y0=y1+yd*6
  228. 2210  IF po MOD 2 THEN pi1=7 ELSE pi1=9
  229. 2220  RETURN
  230. 2230  GOSUB 2150
  231. 2240  mx=x:if mn<6 then radius=6 else radius=6
  232. 2250  my=y0+yd*13*((mn-1) MOD 5):if mn>5 then my=y0+yd*13*((6-1) mod 5)
  233. 2260  RETURN
  234. 2270  GOSUB 2230
  235. 2275  rem if mn>5 then gosub 25000:goto 2290
  236. 2280  peno (1-pc)+5:CIRCLE(mx,my),radius:pena pc+5:PAINT(mx-5,my),0
  237. 2285  if mn>5 then gosub 25000:goto 2290
  238. 2290  RETURN
  239. 2300  REM
  240. 2310  GOSUB 2230
  241. 2320  peno 8:CIRCLE(mx,my),radius:pena 8:PAINT(mx,my),0
  242. 2330  IF po=0 OR po=25 THEN pena 11:GOTO 2350
  243. 2340  pena 15:draw(x-12,y1 TO x,y2):draw(x,y2 TO x+12,y1):pena pi1
  244. 2350  peno 15:PAINT(mx,my),1
  245. 2360  if mn>1 then for mn=1 to mn-1:gosub 2270:next mn
  246. 2370  RETURN
  247. 2380  mn=ABS(b(mpt)):po=mpt:GOSUB 2230
  248. 2382  qq=sound(1,1,5,64,3000):qq=sound(2,1,5,64,6000)
  249. 2385  qq=1:if pl=1 then qq=5
  250. 2390  pena 16:paint(mx-5,my),1
  251. 2392  pena 8:paint(mx-5,my),1
  252. 2395  qq=qq+1:if qq<5 then 2390
  253. 2400  return
  254. 2410  po=mpt:mn=b(mpt):GOSUB 2270:RETURN
  255. 2420  IF pl=1 THEN dx=46 ELSE dx=202
  256. 2425  sleep(.5*10^6):randomize -1
  257. 2430  FOR dj=0 TO 1:xd=dx+dj*33:IF d(dj)=0 THEN 2460
  258. 2440  rem
  259. 2450  ON d(dj) GOSUB 2520,2530,2540,2550,2560,2570
  260. 2460  NEXT dj
  261. 2470  RETURN
  262. 2520  gshape(xd,75),dice1%():return
  263. 2530  gshape(xd,75),dice2%():return
  264. 2540  gshape(xd,75),dice3%():return
  265. 2550  gshape(xd,75),dice4%():return
  266. 2560  gshape(xd,75),dice5%():return
  267. 2570  gshape(xd,75),dice6%():return
  268. 2580  REM
  269. 2590  IF pl=1 THEN dx=46 ELSE dx=202
  270. 2600  xd=dx+di*32
  271. 2610  pena 8:peno 8:area (xd,75 to xd+25,75 to xd+25,97 to xd,97)
  272. 2640  d(di)=0
  273. 2650  return
  274. 2700  REM
  275. 2720  ask MOUSE xc%,yc%,b%
  276. 2730  IF b%=4 THEN 2720
  277. 2740  ask MOUSE xc%,yc%,b%
  278. 2760  IF b%=0 THEN 2740
  279. 2770  xc=xc%:yc=yc%:button=b%:RETURN
  280. 25000 drawmode 0
  281. 25010 if pl=1 then pena 5:peno 5 else pena 6:peno 6
  282. 25015 area(mx-3,my+3 to mx+3,my+3 to mx+3,my-3 to mx-3,my-3):drawmode 0
  283. 25018 if pl=1 then pena 6:penb 5 else pena 5:penb 6
  284. 25020 ? at(mx-11,my+3);mn-4
  285. 25030 drawmode 0:return
  286. 30000 cnt=0:i=0
  287. 30010 rgb i,regsave%(cnt),regsave%(cnt+1),regsave%(cnt+2):cnt=cnt+3
  288. 30030 i=i+1:IF i<32 THEN 30010
  289. 30040 RETURN
  290. 37000 for qq=1 to 40
  291. 37005 ask rgb 7,r%,g%,b%
  292. 37010 for i%=9 to 7 step -2
  293. 37020 ask rgb i%,r1%,g1%,b1%
  294. 37030 rgb i%,r%,g%,b%
  295. 37040 r%=r1%:g%=g1%:b%=b1%
  296. 37045 sleep(50000)
  297. 37050 next i%
  298. 37060 next qq
  299. 37070 return
  300. 40000 scnclr:rgb 31,0,0,0:system
  301. 41000 qq=sound(1,1,5,64,500):qq=sound(2,1,5,64,1000):return
  302.